home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0687.arc / EXPAND.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-25  |  1.6 KB  |  55 lines
  1.  
  2. {EXPAND.PAS is a procedure written for the IBM PC and its compatibles
  3.  in Turbo Pascal for the purpose of expanding data compressed with
  4.  COMPRESS.PAS.    It is not a stand-alone program.}
  5.  
  6. {Fill <count> words of memory starting at <seg:ofs>
  7.  with the 16-bit value <word>}
  8.  
  9. procedure FillW(seg,ofs,count,word:integer);
  10. begin
  11.     inline
  12.     ($8B/$86/seg/    {MOV AX,seg}
  13.      $8E/$C0/        {MOV ES,AX}
  14.      $8B/$BE/ofs/    {MOV DI,ofs}
  15.      $8B/$86/word/    {MOV AX,word}
  16.      $8B/$8E/count/    {MOV CX,count}
  17.      $FC/        {CLD}
  18.      $F3/$AB)        {REPZ STOSW}
  19. end;
  20.  
  21. procedure Expand(srcofs,picsize:integer);
  22.  
  23. const escapechar = $F800;      {binary 1111100000000000}
  24.       transparent = $07FA;
  25.       scrnseg = $B800;           {start segment of video RAM}
  26.  
  27. var srcptr,destptr,data,runlength,i: integer;
  28.  
  29. begin
  30.   srcptr  := 0;
  31.   destptr := 0;
  32.   while srcptr < picsize * 2 do
  33.   begin
  34.     data   := MemW[Cseg:srcofs+srcptr];        {fetch next word}
  35.     srcptr := srcptr + 2;
  36.     if (data and escapechar) = escapechar       {test top 5 bits}
  37.     then begin                       {it's a count word}
  38.       runlength := data xor escapechar;        {unpack count part}
  39.       data  := MemW[Cseg:srcofs+srcptr];       {fetch next word}
  40.       srcptr := srcptr + 2;
  41.       if data = transparent               {color is transparent}
  42.       then destptr := destptr + (2 * runlength)    {so just bump pointer}
  43.       else begin
  44.     FillW(scrnseg,destptr,runlength,data);       {fill screen memory}
  45.     destptr := destptr + (2 * runlength)
  46.       end
  47.     end
  48.     else begin                       {it's a singleton}
  49.       MemW[scrnseg:destptr] := data;
  50.       destptr := destptr + 2
  51.     end
  52.   end
  53. end;
  54.  
  55. e begin